home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbmess.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-02-16  |  18.7 KB  |  505 lines
  1. (*===========================================================================*)
  2. (* Message handling                                                          *)
  3. (*                                                                           *)
  4. (*   Copyright 1988, 1989, 1990, 1991 by H. Roy Engehausen.  All rights      *)
  5. (*   reserved.                                                               *)
  6. (*                                                                           *)
  7. (*===========================================================================*)
  8.  
  9. {$UNDEF DEBUG_L1} (* Debug language selection *)
  10.  
  11. {$O+}
  12.  
  13. UNIT BBMESS;
  14.  
  15. INTERFACE
  16.  
  17.   PROCEDURE send_message   (message_no : BYTE);
  18.  
  19.   FUNCTION  get_message    (message_no : BYTE) : STRING;
  20.  
  21.   PROCEDURE substitute_line(VAR in_str : STRING);
  22.  
  23. IMPLEMENTATION
  24.  
  25. USES
  26.   CRT,
  27.   bbdummy,
  28.   bbfssf,
  29.   bbmdata,
  30.   bbmem,
  31.   bbmf,
  32.   bbmisc5,
  33.   bbsdata,
  34.   bbstr,
  35.   bbtask,
  36.   bbtime;
  37.  
  38. (*===========================================================================*)
  39. (* Substitute a variable                                                     *)
  40. (*===========================================================================*)
  41.  
  42. FUNCTION substitute_var(this_one : CHAR) : STRING;
  43.  
  44.   VAR
  45.     counter      : WORD;
  46.     tone         : INTEGER;
  47.     t_ptr        : str_ptr;
  48.     t_str        : STRING[12];
  49.  
  50.   (*-------------------------------------------------------------------------*)
  51.   (*  Subroutine to count messages                                           *)
  52.   (*-------------------------------------------------------------------------*)
  53.  
  54.   PROCEDURE count_messages;
  55.  
  56.     VAR
  57.       i            : WORD;
  58.       search_block : search_block_type;
  59.  
  60.     BEGIN;
  61.  
  62.       FILLCHAR(search_block, SIZEOF(search_block), #0);
  63.       search_block.search_nok := TRUE;
  64.  
  65.       CASE this_one OF
  66.         'R' : BEGIN;
  67.                 search_block.search_type  := 'R';
  68.                 search_block.search_str   := active_tcb^.uid_data.user_id;
  69.               END;
  70.         'r' : BEGIN;
  71.                 search_block.search_type  := 'D';
  72.                 search_block.search_dt    := active_tcb^.uid_data.user_l_time;
  73.                 search_block.search_above := TRUE;
  74.               END;
  75.       END;
  76.  
  77.       search_block.search_last := NIL;
  78.       i := 0;
  79.  
  80.       REPEAT
  81.         search_msg(@search_block);
  82.         INC(i);
  83.         IF (i MOD 10) = 0 THEN task_switch;
  84.       UNTIL search_block.search_last = NIL;
  85.  
  86.       counter := i - 1;
  87.  
  88.     END;
  89.  
  90.   (*-------------------------------------------------------------------------*)
  91.   (* Main line of substitute var                                             *)
  92.   (*-------------------------------------------------------------------------*)
  93.  
  94.   BEGIN;
  95.  
  96.     (*-----------------------------------------------------------------------*)
  97.     (*                                                                       *)
  98.     (*  $A - @ BBS of the current message.                                   *)
  99.     (*  $a - Call of the originating bbs.                                    *)
  100.     (*  $B - Type of current message (single letter)                         *)
  101.     (*  $b - BID of current message.                                         *)
  102.     (*  $C - The message type (by name)                                      *)
  103.     (*  $D - The current date.                                               *)
  104.     (*  $E - Title of current message.                                       *)
  105.     (*  $F - Name of the users port.                                         *)
  106.     (*  $f - Name of the "other" gateway port.                               *)
  107.     (*  $G - TO of the current message.                                      *)
  108.     (*  $g - TO "H" address of current message                               *)
  109.     (*  $H - Hang at end of line (suppress carriage return).                 *)
  110.     (*     Use at end of line only. DO NOT USE on lines that go to tnc.      *)
  111.     (*  $h - Home BBS of the connected user                                  *)
  112.     (*  $I - Sysops name.                                                    *)
  113.     (*  $J - Date from current msg header                                    *)
  114.     (*  $j - Date from orig msg header                                       *)
  115.     (*  $K - Time from current msg header.                                   *)
  116.     (*  $k - Time from orig msg header.                                      *)
  117.     (*  $L - Number of the last message in the MailBox                       *)
  118.     (*  $l - Date/time of user's last "L" command.                           *)
  119.     (*  $M - Message number from current msg header.                         *)
  120.     (*  $m - Message number from orig msg header.                            *)
  121.     (*  $N - Number of active messages.                                      *)
  122.     (*  $n - Number of killed messages.                                      *)
  123.     (*  $O - Sysops callsign.                                                *)
  124.     (*  $o - Hierarchical address of this BBS                                *)
  125.     (*  $P - FROM from current msg header.                                   *)
  126.     (*  $p - FROM "H" address                                                *)
  127.     (*  $Q - Sysops QTH                                                      *)
  128.     (*  $q - Language setting for this user.                                 *)
  129.     (*  $R - Number of messages awaiting to be read by this user  (LM)       *)
  130.     (*  $r - Number of messages awaiting to be listed by this user (L)       *)
  131.     (*  $S - Status of current message.                                      *)
  132.     (*  $s - Screen length of user.                                          *)
  133.     (*  $T - The current time.                                               *)
  134.     (*  $t - Task ID.                                                        *)
  135.     (*  $U - User callsign.                                                  *)
  136.     (*  $u - User authentication requirements                                *)
  137.     (*  $V - Software version.                                               *)
  138.     (*  $W - Users name.                                                     *)
  139.     (*  $w - Screen width of user.                                           *)
  140.     (*  $X - Date user last logged in.                                       *)
  141.     (*  $Y - Time user last logged in.                                       *)
  142.     (*  $Z - User's MAX PAC                                                  *)
  143.     (*  $z - User's format                                                   *)
  144.     (*  $1 - Parameter                                                       *)
  145.     (*  $7 - Tone 440 Hz                                                     *)
  146.     (*  $8 - Tone 880 Hz                                                     *)
  147.     (*  $9 - Tone 1320 Hz                                                    *)
  148.     (*  $: - Leave alone                                                     *)
  149.     (*                                                                       *)
  150.     (*-----------------------------------------------------------------------*)
  151.  
  152.     WITH active_tcb^, active_tcb^.uid_data, active_tcb^.curr_msg.msg_i_mb DO
  153.  
  154.       CASE this_one OF
  155.  
  156.         'a':  substitute_var := msg_from_at;
  157.         'b':  substitute_var := msg_bid;
  158.         'd':  BEGIN;
  159.                 STR(msg_number, t_str);
  160.                 substitute_var := t_str;
  161.               END;
  162.         'g':  substitute_var := msg_to_h;
  163.         'h':  substitute_var := user_bbs;
  164.         'j':  substitute_var := COPY(time_str(msg_dt_orig, TRUE) , 1, 6);
  165.         'k':  substitute_var := COPY(time_str(msg_dt_orig, FALSE), 6, 4);
  166.         'l':  substitute_var := time_str(user_l_time, TRUE);
  167.         'm':  BEGIN;
  168.                 STR(msg_no_orig, t_str);
  169.                 substitute_var := t_str;
  170.               END;
  171.         'n':  BEGIN;
  172.                 STR(msg_counter_kill, t_str);
  173.                 substitute_var := t_str;
  174.               END;
  175.         'o':  substitute_var := opt_block.this_bb_h;
  176.         'p':  substitute_var := msg_from_h;
  177.         'q':  substitute_var := user_lang;
  178.         'r', 'R':
  179.               BEGIN;
  180.                 count_messages;
  181.                 STR(counter, t_str);
  182.                 substitute_var := t_str;
  183.               END;
  184.         's':  BEGIN;
  185.                 STR(user_scr_len, t_str);
  186.                 substitute_var := t_str;
  187.               END;
  188.         't':  BEGIN;
  189.                 STR(tcb_number, t_str);
  190.                 substitute_var := port_chan_s + '-' + t_str;
  191.               END;
  192.         'u':  substitute_var := display_access_block(user_access);
  193.         'w':  BEGIN;
  194.                 STR(user_scr_wid, t_str);
  195.                 substitute_var := t_str;
  196.               END;
  197.         'z':  BEGIN;
  198.                 STR(uid_data.user_fmt, t_str);
  199.                 substitute_var := t_str;
  200.               END;
  201.         'A':  substitute_var := msg_to_at;
  202.         'B':  substitute_var := msg_type;
  203.         'C':  BEGIN;
  204.                 CASE msg_type OF
  205.                    'P': substitute_var := get_message(message_mtype_p);
  206.                    'A',
  207.                    'B': substitute_var := get_message(message_mtype_b);
  208.                    'T': substitute_var := get_message(message_mtype_t);
  209.                    'S': substitute_var := get_message(message_mtype_s);
  210.                 ELSE
  211.                    substitute_var := get_message(message_mtype_other);
  212.                 END;
  213.               END;
  214.         'D':  substitute_var := COPY(todays_date_time, 1, 6);
  215.         'E':  substitute_var := msg_subj;
  216.         'F':  substitute_var := active_port^.port_char;
  217.         'G':  substitute_var := msg_to;
  218.         'H':  substitute_var := cr;
  219.         'I':  substitute_var := opt_block.this_bb_name;
  220.         'J':  substitute_var := COPY(time_str(msg_dt_in, TRUE), 1, 6);
  221.         'K':  substitute_var := COPY(time_str(msg_dt_in, FALSE), 6, 4);
  222.         'L':  BEGIN;
  223.                 STR(next_msg_no - 1, t_str);
  224.                 substitute_var := t_str;
  225.               END;
  226.         'M':  BEGIN;
  227.                 STR(msg_number, t_str);
  228.                 substitute_var := t_str;
  229.               END;
  230.         'N':  BEGIN;
  231.                 STR(msg_counter_ok, t_str);
  232.                 substitute_var := t_str;
  233.               END;
  234.         'O':  substitute_var := opt_block.this_bb_sign;
  235.         'P':  substitute_var := msg_from;
  236.         'Q':  substitute_var := opt_block.this_bb_loc;
  237.         (* 'R' is same as 'r' *)
  238.         'S':  substitute_var := msg_flag_char(msg_flag);
  239.         'T':  substitute_var := SUBSTR(todays_date_time, 8, 4);
  240.         'U':  substitute_var := user_id;
  241.         'V':  substitute_var := '1';
  242.         'W':  substitute_var := user_name;
  243.         'X':  substitute_var := COPY(time_str(user_last, TRUE), 1, 6);
  244.         'Y':  substitute_var := COPY(time_str(user_last, FALSE), 6, 4);
  245.         'Z':  BEGIN;
  246.                 STR(uid_data.max_pac, t_str);
  247.                 substitute_var := t_str;
  248.               END;
  249.         '1':  BEGIN;
  250.                 t_ptr := find_task_mem_addr('$1');
  251.                 IF t_ptr <> NIL THEN
  252.                   substitute_var := t_ptr^
  253.                 ELSE
  254.                   substitute_var := '';
  255.               END;
  256.         '7'..'9':
  257.               BEGIN;
  258.                 substitute_var := '';
  259.                 IF active_tcb^.tcb_type <> th_user THEN
  260.                   BEGIN;
  261.                     tone := 440 * (ORD(this_one) - ORD('7') + 1);
  262.                     SOUND(tone);
  263.                     DELAY(100);
  264.                     NOSOUND;
  265.                   END;
  266.               END;
  267.         ':':  substitute_var := '$:';
  268.  
  269.         ELSE
  270.           substitute_var := this_one;
  271.  
  272.       END;
  273.  
  274.   END;
  275.  
  276. (*===========================================================================*)
  277. (* Substitute on a line                                                      *)
  278. (*===========================================================================*)
  279.  
  280. PROCEDURE substitute_line(VAR in_str : STRING);
  281.  
  282.   VAR
  283.     i         : WORD;
  284.     temp_data : STRING;
  285.  
  286.   BEGIN;
  287.  
  288.     temp_data := '';
  289.  
  290.     i := POS('$', in_str);
  291.  
  292.     WHILE i <> 0 DO
  293.       BEGIN;
  294.         IF i = LENGTH(in_str) THEN
  295.           i := 0
  296.         ELSE
  297.           BEGIN;
  298.             IF i > 1 THEN
  299.               temp_data := temp_data + COPY(in_str, 1, i-1);
  300.             temp_data := temp_data + substitute_var(in_str[i+1]);
  301.             in_str := COPY(in_str, i+2, 255);
  302.             i := POS('$', in_str);
  303.           END;
  304.       END;
  305.  
  306.     IF LENGTH(in_str) > 0 THEN
  307.       temp_data := temp_data + in_str;
  308.  
  309.     in_str := temp_data;
  310.  
  311.   END;
  312.  
  313. (*===========================================================================*)
  314. (* Send a message to the user                                                *)
  315. (*===========================================================================*)
  316.  
  317. FUNCTION find_message(message_no : BYTE) : mess_list_ptr;
  318.  
  319.   VAR
  320.     class_to_use : user_class_type;
  321.     i            : WORD;
  322.     lang_to_use  : BYTE;
  323.     mess_head    : mess_list_ptr;
  324.  
  325.   BEGIN;
  326.  
  327.     (*-----------------------------------------------------------------------*)
  328.     (* What message class did we want                                        *)
  329.     (*-----------------------------------------------------------------------*)
  330.  
  331.     class_to_use := active_tcb^.uid_data.user_class;
  332.  
  333.     (*-----------------------------------------------------------------------*)
  334.     (* What language did we want                                             *)
  335.     (*-----------------------------------------------------------------------*)
  336.  
  337.     lang_to_use  := POS(active_tcb^.uid_data.user_lang,
  338.                         opt_block.language_list);
  339.  
  340.     IF lang_to_use = 0 THEN
  341.       lang_to_use  := POS(active_port^.dflt_lang,
  342.                           opt_block.language_list);
  343.  
  344.     IF lang_to_use <> 0 THEN
  345.       DEC(lang_to_use);
  346.  
  347.     (*-----------------------------------------------------------------------*)
  348.     (* Where is it                                                           *)
  349.     (*-----------------------------------------------------------------------*)
  350.  
  351.     mess_head := message_array[message_no];
  352.  
  353.     (*-----------------------------------------------------------------------*)
  354.     (* Search for message                                                    *)
  355.     (*-----------------------------------------------------------------------*)
  356.  
  357.     {$IFDEF DEBUG_L1}
  358.       WRITELN('Search for ', ORD(class_to_use), '/', lang_to_use);
  359.     {$ENDIF}
  360.  
  361.     WHILE (mess_head <> NIL)
  362.               AND ((mess_head^.mess_class > class_to_use)
  363.                              OR ((mess_head^.mess_lang <> lang_to_use)
  364.                                           AND (mess_head^.mess_lang <> 0))) DO
  365.       BEGIN;
  366.         {$IFDEF DEBUG_L1}
  367.           WRITELN('Skipping ', ORD(mess_head^.mess_class),
  368.                                '/', mess_head^.mess_lang);
  369.         {$ENDIF}
  370.         mess_head := mess_head^.mess_next;
  371.       END;
  372.  
  373.     {$IFDEF DEBUG_L1}
  374.       WRITELN('Found ', ORD(mess_head^.mess_class),
  375.                         '/', mess_head^.mess_lang);
  376.     {$ENDIF}
  377.  
  378.     find_message := mess_head;
  379.  
  380.   END;
  381.  
  382. (*===========================================================================*)
  383. (* Send a message to the user                                                *)
  384. (*===========================================================================*)
  385.  
  386. PROCEDURE send_message(message_no : BYTE);
  387.  
  388.   VAR
  389.     class_to_use : user_class_type;
  390.     lang_to_use  : BYTE;
  391.     mess_head    : mess_list_ptr;
  392.     message_line : STRING;
  393.     message_qe   : qe_ptr;
  394.  
  395.   (*=========================================================================*)
  396.   (* Send a message line to the user                                         *)
  397.   (*=========================================================================*)
  398.  
  399.   PROCEDURE send_message_line;
  400.  
  401.     BEGIN;
  402.  
  403.       substitute_line(message_line);
  404.  
  405.       send_tnc_data_str(message_line + cr);
  406.  
  407.     END;
  408.  
  409.   (*=========================================================================*)
  410.   (* Main line of send message                                               *)
  411.   (*=========================================================================*)
  412.  
  413.   BEGIN;
  414.  
  415.     (*-----------------------------------------------------------------------*)
  416.     (* Find message                                                          *)
  417.     (*-----------------------------------------------------------------------*)
  418.  
  419.     mess_head := find_message(message_no);
  420.  
  421.     (*-----------------------------------------------------------------------*)
  422.     (* None found?                                                           *)
  423.     (*-----------------------------------------------------------------------*)
  424.  
  425.     IF mess_head = NIL THEN
  426.       EXIT;
  427.  
  428.     (*-----------------------------------------------------------------------*)
  429.     (* Loop thru outputting message                                          *)
  430.     (*-----------------------------------------------------------------------*)
  431.  
  432.     message_qe   := mess_head^.mess_this;
  433.  
  434.     WHILE message_qe <> NIL DO
  435.       BEGIN;
  436.  
  437.         WITH message_qe^ DO
  438.  
  439.           BEGIN;
  440.  
  441.             IF NOT qe_file_type THEN
  442.               BEGIN;
  443.  
  444.                 message_line := qe_data;
  445.                 send_message_line;
  446.  
  447.               END
  448.             ELSE
  449.               send_file(qe_data, FALSE);
  450.  
  451.             message_qe := message_qe^.qe_next;
  452.  
  453.           END;
  454.  
  455.       END;
  456.  
  457.     (*-----------------------------------------------------------------------*)
  458.     (* Free up any parameter list                                            *)
  459.     (*-----------------------------------------------------------------------*)
  460.  
  461.     free_task_mem('$1', TRUE);
  462.  
  463.   END;
  464.  
  465.  
  466. (*===========================================================================*)
  467. (* Get a message for a user                                                  *)
  468. (*===========================================================================*)
  469.  
  470. FUNCTION  get_message    (message_no : BYTE) : STRING;
  471.  
  472.   VAR
  473.     class_to_use : user_class_type;
  474.     mess_head    : mess_list_ptr;
  475.     message_qe   : qe_ptr;
  476.     t            : STRING;
  477.  
  478.   BEGIN;
  479.  
  480.     mess_head := find_message(message_no);
  481.  
  482.     IF mess_head = NIL THEN
  483.       BEGIN;
  484.         get_message := '';
  485.         EXIT;
  486.       END;
  487.  
  488.     message_qe   := mess_head^.mess_this;
  489.  
  490.     t := message_qe^.qe_data;
  491.  
  492.     substitute_line(t);
  493.  
  494.     get_message  := t;
  495.  
  496.     (*-----------------------------------------------------------------------*)
  497.     (*  Frre up any parameter list                                           *)
  498.     (*-----------------------------------------------------------------------*)
  499.  
  500.     free_task_mem('$1', TRUE);
  501.  
  502.   END;
  503.  
  504. END.
  505.